Esta práctica se ha realizado bajo el contexto de la asignatura Tipología y ciclo de vida de los datos, perteneciente al Máster en Ciencia de Datos de la Universitat Oberta de Catalunya.
Hemos utilizado el juego de datos “Adult Data Set” de UCI Machine Learning Repository (originalmente creado por Ronny Kohavi y Barry Becker). Nuestra tarea consiste en limpiar el dataset, validar los datos y realizar un análisis, aplicando pruebas estadísticas, para determinar si una persona gana más de 50 mil al año según los datos del censo (sobre ingresos) que tuvo lugar el año 1994.
Para más información sobre el juego de datos: http://archive.ics.uci.edu/ml/datasets/Adult
En este proyecto, trabajamos con el conjunto de datos del censo que tuvo lugar el año 1994. El dataset contiene información sociodemográfica de los indivíduos, tales como la edad, el sexo, la educación, la ocupación, o la etnia y una etiqueta binaria que indica si ganan más de 50 mil al año o no. Nos interesa saber si algunas de estas características pueden influir en cuanto a los ingresos que recibe un indivíduo y si existe alguna correlación en los datos.
Los primeros pasos que vamos a realizar son: limpieza del dataset, validación de los datos y un análisis previo, aplicando pruebas estadísticas, para entender mejor nuestro conjunto de datos y determinar cuales de los atributos son los más importantes.
Después del análisis inicial se pueden implementar varios modelos de aprendizaje automático, para conseguir un modelo óptimo de clasificación, que pueda predecir si el ingreso anual de una persona es > = 50k, según sus características sociodemográficas.
Insertamos el juego de datos: “Adult Data Set”.
# Cargamos el juego de datos
datosAdult <- read.csv('http://archive.ics.uci.edu/ml/machine-learning-databases/adult/adult.data',stringsAsFactors = FALSE, header = FALSE)
Añadimos los títulos de cada variable.
# Añadir headers
names(datosAdult) <- c("age","workclass","fnlwgt","education","education.num","marital.status","occupation","relationship","race","sex","capital.gain","capital.loss","hours.week","native.country","income")
Observamos la estructura del juego de datos.
str(datosAdult)
## 'data.frame': 32561 obs. of 15 variables:
## $ age : int 39 50 38 53 28 37 49 52 31 42 ...
## $ workclass : chr " State-gov" " Self-emp-not-inc" " Private" " Private" ...
## $ fnlwgt : int 77516 83311 215646 234721 338409 284582 160187 209642 45781 159449 ...
## $ education : chr " Bachelors" " Bachelors" " HS-grad" " 11th" ...
## $ education.num : int 13 13 9 7 13 14 5 9 14 13 ...
## $ marital.status: chr " Never-married" " Married-civ-spouse" " Divorced" " Married-civ-spouse" ...
## $ occupation : chr " Adm-clerical" " Exec-managerial" " Handlers-cleaners" " Handlers-cleaners" ...
## $ relationship : chr " Not-in-family" " Husband" " Not-in-family" " Husband" ...
## $ race : chr " White" " White" " White" " Black" ...
## $ sex : chr " Male" " Male" " Male" " Male" ...
## $ capital.gain : int 2174 0 0 0 0 0 0 0 14084 5178 ...
## $ capital.loss : int 0 0 0 0 0 0 0 0 0 0 ...
## $ hours.week : int 40 13 40 40 40 40 16 45 50 40 ...
## $ native.country: chr " United-States" " United-States" " United-States" " United-States" ...
## $ income : chr " <=50K" " <=50K" " <=50K" " <=50K" ...
Descripción breve de las variables:
Tenemos 32561 Observaciones y 17 atributos, de los cuales ocho son categóricos y seis continuos.
age: Es la edad de cada indivíduo, tipo de valor entero.
workclass: Tipo de valor cadena. Es la clase laboral: Private, Self-emp-not-inc, Self-emp-inc, Federal-gov, Local-gov, State-gov, Without-pay, Never-worked.
fnlwgt: Tipo de valor entero. El peso muestral final de cada indviduo, basado en factores sociodemográficos. (Personas con características demográficas similares deben tener un peso similar).
education: Tipo de valor cadena. Es la educación que ha recibido cada individuo: Bachelors, Some-college, 11th, HS-grad, Prof-school, Assoc-acdm, Assoc-voc, 9th, 7th-8th, 12th, Masters, 1st-4th, 10th, Doctorate, 5th-6th, Preschool.
education.num: Valor entero. Representación numérica del atributo de educación
marital.status: Tipo de valor cadena. La situación marital del individuo: Married-civ-spouse, Divorced, Never-married, Separated, Widowed, Married-spouse-absent, Married-AF-spouse.
occupation: Cadena. Es el trabajo de cada individuo: Tech-support, Craft-repair, Other-service, Sales, Exec-managerial, Prof-specialty, Handlers-cleaners, Machine-op-inspct, Adm-clerical, Farming-fishing, Transport-moving, Priv-house-serv, Protective-serv, Armed-Forces.
relationship: Cadena. El tipo de relación que corresponde a cada indivíduo: Wife, Own-child, Husband, Not-in-family, Other-relative, Unmarried.
race: Tipo de valor cadena. es la etnia de cada individuo: White, Asian-Pac-Islander, Amer-Indian-Eskimo, Other, Black.
sex: Tipo de valor factor. El sexo: Female, Male.
capital.gain: Valor entero. Es la ganancia de capital
capital.loss: Valor entero. Es la pérdida capital
hours.week: Valor continuo entero. Es la media de las horas que trabaja una persona por semana.
native.country: Cadena. Es el país de origen de cada persona: United-States, Cambodia, England, Puerto-Rico, Canada, Germany, Outlying-US(Guam-USVI-etc), India, Japan, Greece, South, China, Cuba, Iran, Honduras, Philippines, Italy, Poland, Jamaica, Vietnam, Mexico, Portugal, Ireland, France, Dominican-Republic, Laos, Ecuador, Taiwan, Haiti, Columbia, Hungary, Guatemala, Nicaragua, Scotland, Thailand, Yugoslavia, El-Salvador, Trinadad&Tobago, Peru, Hong, Holand-Netherlands.
income: Factor. En este caso es la etiqueta de las muestras e indica si los ingresos de un indivíduo son mayores o menores de 50K.
Hemos visto, en el paso anterior, que existen espacios en blanco en todas las variables tipo cadena.
El primer paso será borrar estos espacios.
# Seleccionar las columnas en formato cadena
chr_columns <- lapply(datosAdult, class) == "character"
# Eliminar espacios en blanco // require(plyr) // require(stringr)
datosAdult[, chr_columns] <- colwise(str_trim)(datosAdult[, chr_columns])
# Vamos, además, a transformar los atributos tipo caracter a factor:
datosAdult[, chr_columns] <- lapply(datosAdult[, chr_columns], as.factor)
# Podemos confirmar los cambios observando de nuevo la estructura del dataset.
#str(datosAdult)
# Utilizamos la función attach para facilitar el ejercicio
attach(datosAdult)
Una vez realizados los primeros cambios podemos examinar el resumen estadístico del conjunto de datos, para obtener más información.
summary(datosAdult)
## age workclass fnlwgt
## Min. :17.00 Private :22696 Min. : 12285
## 1st Qu.:28.00 Self-emp-not-inc: 2541 1st Qu.: 117827
## Median :37.00 Local-gov : 2093 Median : 178356
## Mean :38.58 ? : 1836 Mean : 189778
## 3rd Qu.:48.00 State-gov : 1298 3rd Qu.: 237051
## Max. :90.00 Self-emp-inc : 1116 Max. :1484705
## (Other) : 981
## education education.num marital.status
## HS-grad :10501 Min. : 1.00 Divorced : 4443
## Some-college: 7291 1st Qu.: 9.00 Married-AF-spouse : 23
## Bachelors : 5355 Median :10.00 Married-civ-spouse :14976
## Masters : 1723 Mean :10.08 Married-spouse-absent: 418
## Assoc-voc : 1382 3rd Qu.:12.00 Never-married :10683
## 11th : 1175 Max. :16.00 Separated : 1025
## (Other) : 5134 Widowed : 993
## occupation relationship race
## Prof-specialty :4140 Husband :13193 Amer-Indian-Eskimo: 311
## Craft-repair :4099 Not-in-family : 8305 Asian-Pac-Islander: 1039
## Exec-managerial:4066 Other-relative: 981 Black : 3124
## Adm-clerical :3770 Own-child : 5068 Other : 271
## Sales :3650 Unmarried : 3446 White :27816
## Other-service :3295 Wife : 1568
## (Other) :9541
## sex capital.gain capital.loss hours.week
## Female:10771 Min. : 0 Min. : 0.0 Min. : 1.00
## Male :21790 1st Qu.: 0 1st Qu.: 0.0 1st Qu.:40.00
## Median : 0 Median : 0.0 Median :40.00
## Mean : 1078 Mean : 87.3 Mean :40.44
## 3rd Qu.: 0 3rd Qu.: 0.0 3rd Qu.:45.00
## Max. :99999 Max. :4356.0 Max. :99.00
##
## native.country income
## United-States:29170 <=50K:24720
## Mexico : 643 >50K : 7841
## ? : 583
## Philippines : 198
## Germany : 137
## Canada : 121
## (Other) : 1709
En cuanto a los valores numéricos podemos ver información sobre los cuartiles, la mediana, la media y los valores mínimo y máximo. Vamos a utilizar estos datos más adelante para hacer pruebas de hipótesis e identificar características importantes en el dataset.
Observamos con más detalle las variables tipo factor:
# número de factores en cada variable
sapply(datosAdult[, chr_columns], nlevels)
## workclass education marital.status occupation relationship
## 9 16 7 15 6
## race sex native.country income
## 5 2 42 2
Para una mejor compresión, de la distribución de los datos, calcularemos el total de cada subfactor y su porcentaje:
# Insertamos los factores en un dataframe
df_factors <- data.frame(datosAdult[, chr_columns])
# Calculamos el número y el porcentaje
for (column in df_factors) {
tbl <- table(column)
res <- cbind(tbl,round(prop.table(tbl)*100,2))
colnames(res) <- c('Count','Percentage')
cat("\n")
print(res)
}
##
## Count Percentage
## ? 1836 5.64
## Federal-gov 960 2.95
## Local-gov 2093 6.43
## Never-worked 7 0.02
## Private 22696 69.70
## Self-emp-inc 1116 3.43
## Self-emp-not-inc 2541 7.80
## State-gov 1298 3.99
## Without-pay 14 0.04
##
## Count Percentage
## 10th 933 2.87
## 11th 1175 3.61
## 12th 433 1.33
## 1st-4th 168 0.52
## 5th-6th 333 1.02
## 7th-8th 646 1.98
## 9th 514 1.58
## Assoc-acdm 1067 3.28
## Assoc-voc 1382 4.24
## Bachelors 5355 16.45
## Doctorate 413 1.27
## HS-grad 10501 32.25
## Masters 1723 5.29
## Preschool 51 0.16
## Prof-school 576 1.77
## Some-college 7291 22.39
##
## Count Percentage
## Divorced 4443 13.65
## Married-AF-spouse 23 0.07
## Married-civ-spouse 14976 45.99
## Married-spouse-absent 418 1.28
## Never-married 10683 32.81
## Separated 1025 3.15
## Widowed 993 3.05
##
## Count Percentage
## ? 1843 5.66
## Adm-clerical 3770 11.58
## Armed-Forces 9 0.03
## Craft-repair 4099 12.59
## Exec-managerial 4066 12.49
## Farming-fishing 994 3.05
## Handlers-cleaners 1370 4.21
## Machine-op-inspct 2002 6.15
## Other-service 3295 10.12
## Priv-house-serv 149 0.46
## Prof-specialty 4140 12.71
## Protective-serv 649 1.99
## Sales 3650 11.21
## Tech-support 928 2.85
## Transport-moving 1597 4.90
##
## Count Percentage
## Husband 13193 40.52
## Not-in-family 8305 25.51
## Other-relative 981 3.01
## Own-child 5068 15.56
## Unmarried 3446 10.58
## Wife 1568 4.82
##
## Count Percentage
## Amer-Indian-Eskimo 311 0.96
## Asian-Pac-Islander 1039 3.19
## Black 3124 9.59
## Other 271 0.83
## White 27816 85.43
##
## Count Percentage
## Female 10771 33.08
## Male 21790 66.92
##
## Count Percentage
## ? 583 1.79
## Cambodia 19 0.06
## Canada 121 0.37
## China 75 0.23
## Columbia 59 0.18
## Cuba 95 0.29
## Dominican-Republic 70 0.21
## Ecuador 28 0.09
## El-Salvador 106 0.33
## England 90 0.28
## France 29 0.09
## Germany 137 0.42
## Greece 29 0.09
## Guatemala 64 0.20
## Haiti 44 0.14
## Holand-Netherlands 1 0.00
## Honduras 13 0.04
## Hong 20 0.06
## Hungary 13 0.04
## India 100 0.31
## Iran 43 0.13
## Ireland 24 0.07
## Italy 73 0.22
## Jamaica 81 0.25
## Japan 62 0.19
## Laos 18 0.06
## Mexico 643 1.97
## Nicaragua 34 0.10
## Outlying-US(Guam-USVI-etc) 14 0.04
## Peru 31 0.10
## Philippines 198 0.61
## Poland 60 0.18
## Portugal 37 0.11
## Puerto-Rico 114 0.35
## Scotland 12 0.04
## South 80 0.25
## Taiwan 51 0.16
## Thailand 18 0.06
## Trinadad&Tobago 19 0.06
## United-States 29170 89.59
## Vietnam 67 0.21
## Yugoslavia 16 0.05
##
## Count Percentage
## <=50K 24720 75.92
## >50K 7841 24.08
Destacamos:
income: <=50K: 76%, >50K : 24%
sex: Female 33%, Male 67%.
native.country: United-States 90%, Valor desconocido (“?”) 2%.
race: White 85%.
occupation: Valor desconocido (“?”) 6%.
workclass: Private 70%, Valor desconocido (“?”) 5%.
education: Bachelors 16%, Some-college 22%, 11th 4%, HS-grad 32%, Prof-school 2%, Assoc-acdm 3%, Assoc-voc 4%, 9th 2%, 7th-8th 2%, 12th 2%, Masters 5%, 1st-4th 1%, 10th 3%, Doctorate 1%, 5th-6th 1%, Preschool 1%.
marital.status: Married-civ-spouse 46%, Divorced 14%, Never-married 33%, Separated 3%, Widowed 2%, Married-spouse-absent 1%, Married-AF-spouse 1%.
relationship: Wife 4%, Own-child 16%, Husband 41%, Not-in-family 26%, Other-relative 2%, Unmarried 11%.
Según la descripción del propietario del dataset, los valores desconocidos se han re-emplazado por: “?”, un valor que ya detectamos en los pasos anteriores.
Investigación de valores NA, vacíos o desconocidos:
# NA
colSums(is.na(datosAdult))
## age workclass fnlwgt education education.num
## 0 0 0 0 0
## marital.status occupation relationship race sex
## 0 0 0 0 0
## capital.gain capital.loss hours.week native.country income
## 0 0 0 0 0
# Valores vacíos
colSums(datosAdult=="")
## age workclass fnlwgt education education.num
## 0 0 0 0 0
## marital.status occupation relationship race sex
## 0 0 0 0 0
## capital.gain capital.loss hours.week native.country income
## 0 0 0 0 0
# Valores desconocidos
colSums(datosAdult=="?")
## age workclass fnlwgt education education.num
## 0 1836 0 0 0
## marital.status occupation relationship race sex
## 0 1843 0 0 0
## capital.gain capital.loss hours.week native.country income
## 0 0 0 583 0
Observamos que no existen valores NA o vacíos, pero en las variables: “workclass”, “native.country” y “occupation” tenemos valores desconocidos, “?”.
Veamos cuales son los valores más frecuentes en estas columnnas (también, se pueden consultar los porcentajes):
tail(names(sort(table(datosAdult$workclass))), 1)
## [1] "Private"
tail(names(sort(table(datosAdult$native.country))), 1)
## [1] "United-States"
tail(names(sort(table(datosAdult$occupation))), 1)
## [1] "Prof-specialty"
Obtenemos para la variable “workclass”: “Private”, para “native.country”: “United-States” y para “occupation”: “Prof-specialty”.
Sospechamos que existen valores desconocidos en las mismas líneas, porque “occupation” y “workclass” tienen casi el mismo tamaño de valores “?”.
matching_values_1 = (datosAdult[(occupation=="?" & workclass=="?"),])
nrow(matching_values_1)
## [1] 1836
Efectivamente obtenemos que todas las observaciones que tienen valor desconocido en workclass pertenecen a las observaciones que tienen valor desconocido en occupation.
Pero no ocurre lo mismo para native.country, donde solo 27 de las 583 observaciones coinciden:
matching_values_2 = (datosAdult[(occupation=="?" & native.country=="?"),])
nrow(matching_values_2)
## [1] 27
Para “native.country” hemos decidido reemplazar el valor desconocido por el valor más común ya que el porcentaje de este es bastante alto, en cuanto al atributo “occupation” vamos a borrar las observaciones con atributos desconocidos porque consideramos que el valor más frecuente no es significamente más común que el resto y al borrar estos datos nuestro dataset sigue siendo suficientemente largo. Al borrar dichas observaciones, se eliminan también las observaciones con valores desconocidos en “workclass”, sino fuera el caso, reemplazariamos los “?” en “workclass” por el valor más frequente, como hicimos para “native.country”.
# reemplazar el "?" con el valor más frecuente en native.country.
datosAdult$native.country <- replace(datosAdult$native.country,datosAdult$native.country=="?","United-States")
# eliminar las observaciones con "?" en occupation.
datosAdult <- datosAdult[!(occupation=="?"),]
attach(datosAdult)
# Confirmamos que no quedan valores desconocidos.
colSums(datosAdult=="?")
## age workclass fnlwgt education education.num
## 0 0 0 0 0
## marital.status occupation relationship race sex
## 0 0 0 0 0
## capital.gain capital.loss hours.week native.country income
## 0 0 0 0 0
dim(datosAdult)
## [1] 30718 15
El dataset actualizado tiene 30718 observaciones.
En los atributos tipo factor nos llaman la atención el atributo de “native.country” (con “United-States”: 90%), el atributo de “race” (con “White”: 85%) y el de workclass (con “Private”70%).
Antes de ver los boxplots de los atributos numéricos, podemos crear un scatterplot con todas las clases para ver si hay alguna correlación clara entre los datos.
pairs(datosAdult, pch = 16, col = "blue", main = "Matrix Scatterplot datosAdult", cex.lab=1.5, cex.axis=1.5, cex.main=2.5)
Según el scatterplot, existe una correlación positiva entre “education” y “education.num”, por lo que, podríamos eliminar uno de esos, al crear nuestro modelo predictivo. No se observa una correlación fuerte entre el resto de los atributos.
A continuación, vemos que los números en “education.num” corresponden a un valor del atributo “education”, es decir, son ordenados por título de educación, esto explica la correlación.
head (datosAdult[4:5])
## education education.num
## 1 Bachelors 13
## 2 Bachelors 13
## 3 HS-grad 9
## 4 11th 7
## 5 Bachelors 13
## 6 Masters 14
Vamos a crear boxplots para detectar posibles outliers en los atributos numéricos.
grid.arrange(ggboxplot(datosAdult, x ="income" , y = "age", color = "income"),
ggbarplot(datosAdult, main="With outliers", x="income", y="age", color = "income"),
ggboxplot(datosAdult, x ="income" , y = "education.num", color = "income"),
ggbarplot(datosAdult, main="With outliers", x="income", y="education.num", color = "income"),
ggboxplot(datosAdult, x ="income" , y = "fnlwgt", color = "income"),
ggbarplot(datosAdult, main="With outliers", x="income", y="fnlwgt", color = "income"),
ggboxplot(datosAdult, x ="income", y = "capital.gain", color = "income"),
ggbarplot(datosAdult, main="With outliers", x="income", y="capital.gain", color = "income"),
ggboxplot(datosAdult, x ="income" , y = "capital.loss", color = "income"),
ggbarplot(datosAdult, main="With outliers", x="income", y="capital.loss", color = "income"),
ggboxplot(datosAdult, x ="income" , y = "hours.week", color = "income"),
ggbarplot(datosAdult, main="With outliers", x="income", y="hours.week", color = "income"),
ncol = 2)
Podemos ver más detalles con la función boxplot.stats e incluso calcular la frecuencia de los valores extremos con: count(boxplot.stats(age)$out). Para evitar crear un documento demasiado largo hemos comentado este código.
#boxplot.stats(age)
#count(boxplot.stats(age)$out)
#sum(count(boxplot.stats(age)$out)$freq)
###
#"age" tiene 172 outliers (de 13 valores únicos), el más frequente es el valor 90 que aparece 36 veces
###
#boxplot.stats(education.num)
#count(boxplot.stats(education.num)$out)
#sum(count(boxplot.stats(education.num)$out)$freq)
###
# "education.num" tiene 202 outliers (valores: 1,2, el 2 con freq 156)
###
#boxplot.stats(fnlwgt)
#count(boxplot.stats(fnlwgt)$out)
#sum(count(boxplot.stats(fnlwgt)$out)$freq)
###
# 926 outliers (784 valores únicos indicados como outliers)
###
#boxplot.stats(capital.gain)
#count(boxplot.stats(capital.gain)$out)
#sum(count(boxplot.stats(capital.gain)$out)$freq)
###
# 2589 outliers, (117 valores únicos)
#table(income, capital.gain)
###
#boxplot.stats(capital.loss)
#count(boxplot.stats(capital.loss)$out)
#sum(count(boxplot.stats(capital.loss)$out)$freq)
###
# 1461 outliers, (89 valores únicos)
#table(income, capital.loss)
###
#boxplot.stats(hours.week)
#count(boxplot.stats(hours.week)$out)
#sum(count(boxplot.stats(hours.week)$out)$freq)
###
# 8102 outliers, (74 valores únicos)
###
Los atributos capital.gain y capital.loss tienen muchos valores atípicos, pero la mayoría de las observaciones tienen valor cero:
capital.gain con <=50K
22109 observaciones (el 72% de las instancias) == 0.
capital.gain con >50K
6020 observaciones (el 20% de las instancias) == 0.
capital.loss con <=50K
22364 observaciones (el 73% de las instancias) == 0.
capital.loss con >50K
6893 observaciones (el 22% de las instancias) == 0.
Por lo tanto, es probable que estos atributos no sean muy predictivos.
Nos interesa ver si los siguientes atributos son significativos para determinar si una persona gana <=50K o >50k: “age”, “sex”, “workclass”…
No vamos a considerar el atributo “education” ya que están correlacionados con “education.num” (apartado 3.2) podemos utilizar solo el último. Tampoco vamos a usar el atributo “native.country” ya que el 90% pertenece a “United-States”
Hemos comprobado (apartado 3.2) que existe una correlación positiva entre los atributos “education” y “education.num” y que dicha correlación se debe a que los números en “education.num” corresponden a un valor del atributo “education”. No se observa una correlación fuerte entre el resto de los atributos.
Utilizamos pruebas de contraste de hipótesis en las variables continuas, para identificar si existen diferencias entre la distribución de los valores en las clases <=50K y >50k.
Edad:
Hipótesis nula: H0 = La media de la edad es igual en ambas muestras <=50K y >50k.
Hipótesis alternativa: Ha = La media de la edad es diferente en las muestras <=50K y >50k.
El código se puede encontrar en el siguiente enlace: https://github.com/mvavouri/Data_Cleansing_and_Validation/tree/master/src
Investigación previa: Maria Vavouri y Fernando Moreno
Redacción de las respuestas: Maria Vavouri y Fernando Moreno
Desarrollo código: Maria Vavouri y Fernando Moreno
Top 50 ggplot2 Visualizations - The Master List (With Full R Code) [En linea].
Prabhakaran Selva, r-statistics.co [Consulta 26 de mayo 2019]
http://r-statistics.co/Top50-Ggplot2-Visualizations-MasterList-R-Code.html#Density%20Plot